home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 5 / The 640 Meg Shareware Studio CD-ROM Volume V (Data Express)(1994).ISO / amiga / tempdemo.lha / Rexx / 200YearCalendar.rexx next >
OS/2 REXX Batch file  |  1994-05-22  |  28KB  |  835 lines
  1. /* 
  2.                       _____
  3.                      /      __  _ _   __  __    __  _  __  ____
  4.                      \     /  _/  \  /   /     /   /  /   / __
  5.                    ___\   /        \    / __  /   /      / __
  6.                   /      /  \      /   /     /   /  \   /
  7. ______________________________________________________________________________
  8.  
  9.      200 Year Calendar, ⌐ 1993 by Casa Nova, Sysop of Skyline BBS Berlin.
  10.      It was written for TempestBBS, higher than v1.4u. Started: 08-28-93
  11.  
  12.      Copy to TempRexx: and enter in your optionals TempRexx:PN-200Years.rexx 
  13.  
  14.      Ideen: 
  15.             - Logon-/Logoff-Msgs ausschalten beim Ausfuellen!
  16.             - InterNode Msgs ausschalten (Write Protected mail -> NODE:)
  17.               Kill nicht vergessen!!!
  18.             - ...
  19. ______________________________________________________________________________   */
  20.  
  21.  
  22. /*TRACE RESULTS*/                /*--------------------------*/
  23. OPTIONS RESULTS                                 /*--------------------------*/
  24. ARG BBS_NODE                                    /* Grab the Node Number     */
  25. Address value 'TempRexx-'BBS_NODE               /* Tell Arexx where the BBS Is
  26. ----------------------------------------------------------------------------*/
  27. VERS = '1.0'                                /* DON'T CHANGE!          /
  28. ----------------------------------------------------------------------------*/
  29. PROGRAMNAME = '200 Year Calender'        /* DON'T CHANGE!         /
  30. ----------------------------------------------------------------------------*/
  31. V_DATE = '10-09-93'                             /* DON'T CHANGE!             /
  32. ----------------------------------------------------------------------------*/
  33. 'Getvar' 43                                     /* UserName                 */
  34. RUName = (result)                               /* Name UPPER-CASE          */
  35. Bufferflush                                     /*                          */
  36. signal ON ERROR                                 /*                          */
  37. signal ON HALT                                  /*                          */
  38. signal ON SYNTAX                                /*                          */
  39. signal ON FAILURE                               /*                          */
  40. signal ON IOERR                                 /*                          */
  41.                                                 /*--------------------------*/
  42. 'Getvar' 0                                  /* Path where the BBS is    */
  43. BBS    = (result)                              /* located (don't change!)  */
  44.                                                 /*--------------------------*/
  45. 'Getvar' 4                                      /* Path to the Text: Dir*/
  46. STF    = (result)                               /*                      */
  47.                                                 /*----------------------*/
  48. 'Getvar' 16                                     /*                      */
  49. DATE   = (result)                    /* DATE            */
  50.                                                 /*----------------------*/
  51. 'Getvar' 17                                     /*                      */
  52. TIM    = (result)                    /* TIME            */
  53.                                                 /*----------------------*/
  54. 'Getvar' 18                                     /* Name of the BBS         */
  55. SYSTEM = (result)                               /* (don't change!)         */
  56.                                                 /*----------------------*/
  57. 'Getvar' 109                                    /* User Level           */
  58. LEV    = (result)                               /* (don't change!)      */
  59.                                                 /*----------------------*/
  60. 'Getvar' 208                                    /* UserSlotNumber(User#)*/
  61. SN     = (result)                               /* (don't change!)      */
  62. /*----------------------------------------------------------------------*/
  63. /*address command 'setenv NODE-'BBS_NODE' 'BBS_NODE'' /* No InterNode-MSGs*/*/
  64. /*
  65. vel = REVERSE(''LEV'')
  66. IF LENGTH(''LEV'')=3 THEN DO 
  67.     vell = SUBSTR(''vel'',1,1)
  68. end
  69. IF LENGTH(''LEV'')=2 THEN DO 
  70.     vell = SUBSTR(''vel'',1,1)
  71. end
  72. vel = REVERSE(''LEV'')
  73. vel = REVERSE(''vell'')
  74.  
  75. IF vel = 0 THEN DO
  76.     l=E
  77.     A.29 = 'English'
  78. CALL START
  79. END
  80. IF vel = 2 THEN DO
  81.     l=E
  82.     A.29 = 'English'
  83. CALL START
  84. END
  85. IF vel = 1 THEN DO
  86.     l=G
  87.     A.29 = 'German '
  88. CALL START
  89. END
  90. IF vel = 3 THEN DO
  91.     l=G
  92.     A.29 = 'German '
  93. CALL START
  94. END
  95. */
  96. l=E
  97. a=1
  98. START:
  99. CLS
  100.  
  101. /*---------------------------------------------------------------*/
  102.  
  103. MESSAGE
  104. SENDSTRING 'SKYLINE 200 YearCalendar: Loading data...'
  105. LOOP_2:
  106.  
  107.  
  108.  
  109. /* (B) Month        | (A) Year 1901-2000                                  */
  110. /*            |                            */
  111. /*     123456789012 |                              */
  112.  
  113. S.1 = '400351362402';              A.1925=S.1 ; A.1953=S.1 ; A.1981=S.1 ; B.2009=S.1 ; B.2037=S.1 ; B.2065=S.1 ; B.2093=S.1 
  114. S.2 = '511462403513';              A.1926=S.2 ; A.1954=S.2 ; A.1982=S.2 ; B.2010=S.2 ; B.2038=S.2 ; B.2066=S.2 ; B.2094=S.2 
  115. S.3 = '622503514624';              A.1927=S.3 ; A.1955=S.3 ; A.1983=S.3 ; B.2011=S.3 ; B.2039=S.3 ; B.2067=S.3 ; B.2095=S.3 
  116. S.4 = '034025036146';              A.1928=S.4 ; A.1956=S.4 ; A.1984=S.4 ; B.2012=S.4 ; B.2040=S.4 ; B.2068=S.4 ; B.2096=S.4 
  117. S.5 = '255136140250'; A.1901=S.5 ; A.1929=S.5 ; A.1957=S.5 ; A.1985=S.5 ; B.2013=S.5 ; B.2041=S.5 ; B.2069=S.5 ; B.2097=S.5 
  118. S.6 = '366240251361'; A.1902=S.6 ; A.1930=S.6 ; A.1958=S.6 ; A.1986=S.6 ; B.2014=S.6 ; B.2042=S.6 ; B.2070=S.6 ; B.2098=S.6 
  119. S.7 = '400351362402'; A.1903=S.7 ; A.1931=S.7 ; A.1959=S.7 ; A.1987=S.7 ; B.2015=S.7 ; B.2043=S.7 ; B.2071=S.7 ; B.2099=S.7 
  120. S.8 = '512503514624'; A.1904=S.8 ; A.1932=S.8 ; A.1960=S.8 ; A.1988=S.8 ; B.2016=S.8 ; B.2044=S.8 ; B.2072=S.8 ;            
  121. S.9 = '033614625035'; A.1905=S.9 ; A.1933=S.9 ; A.1961=S.9 ; A.1989=S.9 ; B.2017=S.9 ; B.2045=S.9 ; B.2073=S.9 ;            
  122. S.10= '144025036146'; A.1906=S.10; A.1934=S.10; A.1962=S.10; A.1990=S.10; B.2018=S.10; B.2046=S.10; B.2074=S.10;            
  123. S.11= '255136140250'; A.1907=S.11; A.1935=S.11; A.1963=S.11; A.1991=S.11; B.2019=S.11; B.2047=S.11; B.2075=S.11;            
  124. S.12= '360351362402'; A.1908=S.12; A.1936=S.12; A.1964=S.12; A.1992=S.12; B.2020=S.12; B.2048=S.12; B.2076=S.12;            
  125. S.13= '511462403513'; A.1909=S.13; A.1937=S.13; A.1965=S.13; A.1993=S.13; B.2021=S.13; B.2049=S.13; B.2077=S.13;            
  126. S.14= '622503514624'; A.1910=S.14; A.1938=S.14; A.1966=S.14; A.1994=S.14; B.2022=S.14; B.2050=S.14; B.2078=S.14;            
  127. S.15= '033614625035'; A.1911=S.15; A.1939=S.15; A.1967=S.15; A.1995=S.15; B.2023=S.15; B.2051=S.15; B.2079=S.15;            
  128. S.16= '145136140250'; A.1912=S.16; A.1940=S.16; A.1968=S.16; A.1996=S.16; B.2024=S.16; B.2052=S.16; B.2080=S.16;            
  129. S.17= '366240251361'; A.1913=S.17; A.1941=S.17; A.1969=S.17; A.1997=S.17; B.2025=S.17; B.2053=S.17; B.2081=S.17;            
  130. S.18= '400351362402'; A.1914=S.18; A.1942=S.18; A.1970=S.18; A.1998=S.18; B.2026=S.18; B.2054=S.18; B.2082=S.18;            
  131. S.19= '511462403513'; A.1915=S.19; A.1943=S.19; A.1971=S.19; A.1999=S.19; B.2027=S.19; B.2055=S.19; B.2083=S.19;            
  132. S.20= '623614625035'; A.1916=S.20; A.1944=S.20; A.1972=S.20; B.2000=S.20; B.2028=S.20; B.2056=S.20; B.2084=S.20;            
  133. S.21= '144025036146'; A.1917=S.21; A.1945=S.21; A.1973=S.21; B.2001=S.21; B.2029=S.21; B.2057=S.21; B.2085=S.21;            
  134. S.22= '255136140250'; A.1918=S.22; A.1946=S.22; A.1974=S.22; B.2002=S.22; B.2030=S.22; B.2058=S.22; B.2086=S.22;            
  135. S.23= '366240251361'; A.1919=S.23; A.1947=S.23; A.1975=S.23; B.2003=S.23; B.2031=S.23; B.2059=S.23; B.2087=S.23;            
  136. S.24= '401462403513'; A.1920=S.24; A.1948=S.24; A.1976=S.24; B.2004=S.24; B.2032=S.24; B.2060=S.24; B.2088=S.24;            
  137. S.25= '622503514624'; A.1921=S.25; A.1949=S.25; A.1977=S.25; B.2005=S.25; B.2033=S.25; B.2061=S.25; B.2089=S.25;            
  138. S.26= '033614625035'; A.1922=S.26; A.1950=S.26; A.1978=S.26; B.2006=S.26; B.2034=S.26; B.2062=S.26; B.2090=S.26;            
  139. S.27= '144025036146'; A.1923=S.27; A.1951=S.27; A.1979=S.27; B.2007=S.27; B.2035=S.27; B.2063=S.27; B.2091=S.27;            
  140. S.28= '256240251361'; A.1924=S.28; A.1952=S.28; A.1980=S.28; B.2008=S.28; B.2036=S.28; B.2064=S.28; B.2092=S.28;            
  141. START2:
  142. CLS
  143. MESSAGE
  144. MESSAGE ' SKYLINE 200 YearCalendar V'VERS'     Designed for Skyline by Casa Nova ['V_DATE'] '
  145. MESSAGE ''COPIES('_',80)''
  146. MESSAGE
  147. Q0:
  148. MESSAGE
  149. Q0.E = SENDSTRING 'Please enter the Year (1901-2099) or [?] for Instruction : '
  150. Q0.G = SENDSTRING 'Bitte das Jahr eingeben (1901-2099) oder [?] fuer Erklaerung : '
  151.  
  152. Q0.l
  153. QUERY
  154. YEAR=result
  155. YER=result
  156.  
  157. IF YEAR='q' THEN DO
  158.       CALL DONE2
  159. END
  160.  
  161. IF YEAR='?' THEN DO
  162.       Q1.E = MESSAGE   '     This 200-Year-Calendar displays the weekday for a requested day.'
  163.       Q2.E = MESSAGE   '     Just enter  the  Date you  are seaching  for:  YEAR, MONTH, DAY.'
  164.       Q3.E = MESSAGE   '     Now the program displays a complete month of the requested year.'
  165.       Q4.E = MESSAGE   '     The day you`re searching for is marked.'
  166.       Q5.E = MESSAGE   '     Leap-Years will be correct calculated and shown.'
  167.  
  168.       Q1.G = MESSAGE   '   Der 200-Jahr-Kalender zeigt den Wochentag zu einem eingegebenen Datum.'
  169.       Q2.G = MESSAGE   '   Die Eingabe des  Datums erfolgt in der Reihenfolge:  JAHR, MONAT, TAG.'
  170.       Q3.G = MESSAGE   '   Anschliessend wird eine Monatsuebersicht des  gewaehlten Jahres/Monats'
  171.       Q4.G = MESSAGE   '   angezeigt. Der gesuchte Tag wird darin markiert.'
  172.       Q5.G = MESSAGE   '   Schaltjahre werden korrekt berechnet und angezeigt.'
  173.       MESSAGE
  174.       Q9.E= SENDSTRING '     Continue with [RETURN] or [Q]uit: '
  175.       Q9.G= SENDSTRING '   Weiter mit [RETURN] oder [E]nde: '
  176.       MESSAGE
  177.       Q1.l
  178.       Q2.l
  179.       Q3.l
  180.       Q4.l
  181.       Q5.l
  182.       MESSAGE
  183.       MESSAGE 
  184.       Q9.l
  185.       GETCHAR
  186.       GOON =upper(RESULT)
  187.       IF GOON='Q' THEN DO
  188.          CALL DONE
  189.       END
  190.       IF GOON='E' THEN DO
  191.          CALL DONE
  192.       END
  193.       CALL START2
  194. END
  195.  
  196. IF YEAR>2099 THEN DO
  197.       Q0e.E = MESSAGE 'Can`t allocate that Year. Try again!'
  198.       Q0e.G = MESSAGE 'Was soll denn das sein? Versuchs nochmal!'
  199.       MESSAGE
  200.       Q0e.l
  201.       MESSAGE
  202.       MESSAGE
  203.       CALL Q0
  204. END
  205. IF YEAR<1901 THEN DO
  206.       Q0e.E = MESSAGE 'Can`t allocate that Year. Try again!'
  207.       Q0e.G = MESSAGE 'Die Jahresangabe ist zu klein.  Versuchs nochmal!'
  208.       MESSAGE
  209.       Q0e.l
  210.       MESSAGE
  211.       MESSAGE
  212.       CALL Q0
  213. END
  214. IF DATATYPE(''YER'','n') then
  215.   CALL GO_ON
  216. else do
  217.       Q0v.E =   MESSAGE ' ERROR: Ooops, don`t use alphanumerics. Use numbers only!'
  218.       Q0w.E =SENDSTRING ''
  219.       Q0v.G =   MESSAGE ' Verwende keine Buchstaben.'
  220.       Q0w.G =   MESSAGE ' Benutze nur Zahlen zur Eingabe!'
  221.       MESSAGE
  222.       Q0v.l
  223.       Q0w.l
  224.       MESSAGE
  225.       MESSAGE
  226.       CALL Q0
  227. END
  228. GO_ON:
  229. max1=4
  230. min1=4
  231. IF LENGTH(''YER'')>max1 then do
  232.       Q0a.E = MESSAGE 'That number is too long. Try again...'
  233.       Q0a.G = MESSAGE 'Die angegebene Zahl ist zu lang! Versuchs nochmal...'
  234.       MESSAGE
  235.       Q0a.l
  236.       MESSAGE
  237.       MESSAGE
  238.       CALL Q0
  239. END
  240. IF LENGTH(''YER'')<min1 then do
  241.       Q0e.E = MESSAGE 'What`s that...? Try again!'
  242.       Q0e.G = MESSAGE 'Was soll denn das sein? Versuchs nochmal!'
  243.       MESSAGE
  244.       Q0e.l
  245.       MESSAGE
  246.       MESSAGE
  247.       CALL Q0
  248. END
  249.  
  250.  
  251.  
  252. FLAG = SUBSTR(''YEAR'',1,2,)        /* This one checks if User has  */
  253. IF FLAG=19 THEN DO                /* entered 19xx ...             */
  254.    YEAR=A.YEAR
  255. END
  256. IF FLAG=20 THEN DO                /* ... or 20xx                  */
  257.    YEAR=B.YEAR
  258. END
  259.  
  260. Q1:
  261. MESSAGE
  262.  
  263. Q0.E = SENDSTRING 'Please enter the Month (1-12): '
  264. Q0.G = SENDSTRING 'Bitte den Monat eingeben (1-12): '
  265. Q0.l   
  266. QUERY
  267. MONTH=result
  268. C_MOM=result
  269. IF MONTH>12 THEN DO
  270.       Q0e.E = MESSAGE 'That number is too big. Try again!'
  271.       Q0e.G = MESSAGE 'Was soll denn das sein? Versuchs nochmal!'
  272.       MESSAGE
  273.       Q0e.l
  274.       MESSAGE
  275.       MESSAGE
  276.       CALL Q1
  277. END
  278. IF MONTH<1 THEN DO
  279.       Q0e.E = MESSAGE 'What`s that? Try again!'
  280.       Q0e.G = MESSAGE 'Was soll denn das sein? Versuchs nochmal!'
  281.       MESSAGE
  282.       Q0e.l
  283.       MESSAGE
  284.       MESSAGE
  285.       CALL Q1
  286. END
  287. IF DATATYPE(''MONTH'','n') then
  288.   CALL GO_ON2
  289. else do
  290.       Q0v.E =   MESSAGE ' ERROR: Ooops, don`t use alphanumerics. Use numbers only!'
  291.       Q0w.E =SENDSTRING ''
  292.       Q0v.G =   MESSAGE ' Verwende keine Buchstaben.'
  293.       Q0w.G =   MESSAGE ' Benutze nur Zahlen zur Eingabe!'
  294.       MESSAGE
  295.       Q0v.l
  296.       Q0w.l
  297.       MESSAGE
  298.       MESSAGE
  299.       CALL Q1
  300. END
  301. GO_ON2:
  302. max1=2
  303. min1=1
  304. IF LENGTH(''MONTH'')>max1 then do
  305.       Q0a.E = MESSAGE 'That number is too long. Try again...'
  306.       Q0a.G = MESSAGE 'Die angegebene Zahl ist zu lang! Versuchs nochmal...'
  307.       MESSAGE
  308.       Q0a.l
  309.       MESSAGE
  310.       MESSAGE
  311.       CALL Q1
  312. END
  313. IF LENGTH(''MONTH'')<min1 then do
  314.       Q0e.E = MESSAGE 'What`s that...? Try again!'
  315.       Q0e.G = MESSAGE 'Was soll denn das sein? Versuchs nochmal!'
  316.       MESSAGE
  317.       Q0e.l
  318.       MESSAGE
  319.       MESSAGE
  320.       CALL Q1
  321. END
  322.     CECK_YEAR = SUBSTR(''DATE'',7,2,)        /* Aktuelles Jahr       */
  323.     CHECK_YEAR = 19||CECK_YEAR 
  324.  
  325. YE=1900                        /* 1. Schaltjahr 1900     */
  326.  DO A = 1 TO 49                    /* 1901-2099 (= 49)    */
  327.  YE=YE+4                    /* Alle 4 Jahre        */
  328.     IF YE = YER THEN DO
  329.        SJ1.E = 'The Year'
  330.        SJ1.G = 'Das Jahr'
  331.        SJ2.E = 'Leap-Year. '
  332.        SJ2.G = 'Schaltjahr.'
  333.        Q4e   = ''YER
  334.        IF CHECK_YEAR < YER THEN DO        
  335.           Q4d.E = 'is a'
  336.           Q4d.G = 'ist ein'
  337.        END
  338.        IF CHECK_YEAR > YER THEN DO        
  339.           Q4d.E = 'was a'
  340.           Q4d.G = 'war ein'
  341.        END
  342.        IF CHECK_YEAR = YER THEN DO        
  343.           Q4d.E = 'is a'
  344.           Q4d.G = 'ist ein'
  345.     END
  346.        CALL NEXT0                /* Schaltjahr -> NEXT:    */
  347.     END
  348.     IF YE ~= YER THEN DO
  349.        SJ1.E = '        '
  350.        SJ1.G = '        '
  351.        SJ2.E = '           '
  352.        SJ2.G = '           '
  353.        Q4d.E = '    '
  354.        Q4d.G = '       '
  355.        Q4e   = ''
  356.     END
  357.  END A
  358.  
  359. NEXT0:
  360. IF month = 1 THEN DO
  361.  mont.E = 'January'
  362.  mont.G = 'Januar'
  363.  mont# = '01'
  364.  mon=31
  365. END
  366. IF month = 2 THEN DO
  367.  mont.E = 'February'
  368.  mont.G = 'Februar'
  369.  mont# = '02'
  370.  YE=1900                    /* 1. Schaltjahr 1900     */
  371.  DO F = 1 TO 49                    /* 1901-2099 (= 49)    */
  372.  YE=YE+4                    /* Alle 4 Jahre        */
  373.     IF YE = YER THEN DO
  374.        mon=29
  375.        CALL NEXT                /* Schaltjahr -> NEXT:    */
  376.     END
  377.     IF YE ~= YER THEN DO
  378.        mon=28
  379.     END
  380.  END F
  381. END
  382. IF month = 3 THEN DO
  383.  mont.E = 'March'
  384.  mont.G = 'Maerz'
  385.  mont# = '03'
  386.  mon=31
  387. END
  388. IF month = 4 THEN DO
  389.  mont.E = 'April'
  390.  mont.G = 'April'
  391.  mont# = '04'
  392.  mon=30
  393. END
  394. IF month = 5 THEN DO
  395.  mont.E = 'May'
  396.  mont.G = 'Mai'
  397.  mont# = '05'
  398.  mon=31
  399. END
  400. IF month = 6 THEN DO
  401.  mont.E = 'June'
  402.  mont.G = 'Juni'
  403.  mont# = '06'
  404.  mon=30
  405. END
  406. IF month = 7 THEN DO
  407.  mont.E = 'July'
  408.  mont.G = 'Juli'
  409.  mont# = '07'
  410.  mon=31
  411. END
  412. IF month = 8 THEN DO
  413.  mont.E = 'August'
  414.  mont.G = 'August'
  415.  mont# = '08'
  416.  mon=31
  417. END
  418. IF month = 9 THEN DO
  419.  mont.E = 'September'
  420.  mont.G = 'September'
  421.  mont# = '09'
  422.  mon=30
  423. END
  424.  
  425. IF month = 10 THEN DO
  426.  mont.E = 'October'
  427.  mont.G = 'Oktober'
  428.  mont# = '10'
  429.  mon=31
  430. END
  431.  
  432. IF month =11 THEN DO
  433.  mont.E = 'November'
  434.  mont.G = 'November'
  435.  mont# = '11'
  436.  mon=30
  437. END
  438.  
  439. IF month =12 THEN DO
  440.  mont.E = 'December'
  441.  mont.G = 'Dezember'
  442.  mont# = '12'
  443.  mon=31
  444. END
  445.  
  446. NEXT:                        /* Schaltjahr        */
  447.  
  448.  
  449. MONTH = SUBSTR(''YEAR'',''MONTH'',1,)        
  450.  
  451. MESSAGE
  452. Q2.E = SENDSTRING 'Please enter the Day (1-'mon'): '
  453. Q2.G = SENDSTRING 'Bitte den Tag eingeben (1-'mon'): '
  454. Q2:
  455. Q2.l   
  456. QUERY
  457. DAY=result
  458. DAT=result
  459. IF DAY>mon THEN DO
  460.       Q2a.E = MESSAGE    'Number is too big. The 'mont.l' only has 'mon' days!'
  461.       Q2.E  = SENDSTRING 'Enter a number between 1 and 'mon': '
  462.       Q2a.G = MESSAGE    'Zahl ist zu gross. Der Monat 'mont.l' hat nur 'mon' Tage.'
  463.       Q2.G  = SENDSTRING 'Gib` eine Zahl zwischen 1 und 'mon' ein: '
  464.       MESSAGE
  465.       Q2a.l
  466.       Q2b.l
  467.       MESSAGE
  468.       MESSAGE
  469.       CALL Q2
  470. END
  471. IF DAY<1 THEN DO
  472.       Q0e.E = MESSAGE 'What`s that? Try again!'
  473.       Q0e.G = MESSAGE 'Was soll denn das sein? Versuchs nochmal!'
  474.       MESSAGE
  475.       Q0e.l
  476.       MESSAGE
  477.       MESSAGE
  478.       CALL Q2
  479. END
  480. IF DATATYPE(''DAY'','n') then
  481.   CALL GO_ON3
  482. else do
  483.       Q0v.E =   MESSAGE ' ERROR: Ooops, don`t use alphanumerics. Use numbers only!'
  484.       Q0w.E =SENDSTRING ''
  485.       Q0v.G =   MESSAGE ' Verwende keine Buchstaben.'
  486.       Q0w.G =   MESSAGE ' Benutze nur Zahlen zur Eingabe!'
  487.       MESSAGE
  488.       Q0v.l
  489.       Q0w.l
  490.       MESSAGE
  491.       MESSAGE
  492.       CALL Q2
  493. END
  494. GO_ON3:
  495. max3=2
  496. min3=1
  497. IF LENGTH(''DAY'')>max3 then do
  498.       Q0a.E = MESSAGE 'That number is too long. Try again...'
  499.       Q0a.G = MESSAGE 'Die angegebene Zahl ist zu lang! Versuchs nochmal...'
  500.       MESSAGE
  501.       Q0a.l
  502.       MESSAGE
  503.       MESSAGE
  504.       CALL Q2
  505. END
  506. IF LENGTH(''DAY'')<min3 then do
  507.       Q0e.E = MESSAGE 'What`s that...? Try again!'
  508.       Q0e.G = MESSAGE 'Was soll denn das sein? Versuchs nochmal!'
  509.       MESSAGE
  510.       Q0e.l
  511.       MESSAGE
  512.       MESSAGE
  513.       CALL Q2
  514. END
  515.  
  516. WDAY.E.1 ='Sunday'    
  517. WDAY.G.1 ='Sonntag'   
  518. WDAY.E.2 ='Monday'    
  519. WDAY.G.2 ='Montag'    
  520. WDAY.E.3 ='Tuesday'   
  521. WDAY.G.3 ='Dienstag'  
  522. WDAY.E.4 ='Wednesday' 
  523. WDAY.G.4 ='Mittwoch'  
  524. WDAY.E.5 ='Thursday'  
  525. WDAY.G.5 ='Donnerstag'
  526. WDAY.E.6 ='Friday'    
  527. WDAY.G.6 ='Freitag'   
  528. WDAY.E.7 ='Saturday'  
  529. WDAY.G.7 ='Samstag'   
  530. WDAY.E.8 ='Sunday'    
  531. WDAY.G.8 ='Sonntag'   
  532. WDAY.E.9 ='Monday'    
  533. WDAY.G.9 ='Montag'    
  534. WDAY.E.10='Tuesday'   
  535. WDAY.G.10='Dienstag'  
  536. WDAY.E.11='Wednesday' 
  537. WDAY.G.11='Mittwoch'  
  538. WDAY.E.12='Thursday'  
  539. WDAY.G.12='Donnerstag'
  540. WDAY.E.13='Friday'    
  541. WDAY.G.13='Freitag'   
  542. WDAY.E.14='Saturday'  
  543. WDAY.G.14='Samstag'   
  544. WDAY.E.15='Sunday'    
  545. WDAY.G.15='Sonntag'   
  546. WDAY.E.16='Monday'    
  547. WDAY.G.16='Montag'    
  548. WDAY.E.17='Tuesday'   
  549. WDAY.G.17='Dienstag'  
  550. WDAY.E.18='Wednesday' 
  551. WDAY.G.18='Mittwoch'  
  552. WDAY.E.19='Thursday'  
  553. WDAY.G.19='Donnerstag'
  554. WDAY.E.20='Friday'    
  555. WDAY.G.20='Freitag'   
  556. WDAY.E.21='Saturday'  
  557. WDAY.G.21='Samstag'   
  558. WDAY.E.22='Sunday'    
  559. WDAY.G.22='Sonntag'   
  560. WDAY.E.23='Monday'    
  561. WDAY.G.23='Montag'    
  562. WDAY.E.24='Tuesday'   
  563. WDAY.G.24='Dienstag'  
  564. WDAY.E.25='Wednesday' 
  565. WDAY.G.25='Mittwoch'  
  566. WDAY.E.26='Thursday'  
  567. WDAY.G.26='Donnerstag'
  568. WDAY.E.27='Friday'    
  569. WDAY.G.27='Freitag'   
  570. WDAY.E.28='Saturday'  
  571. WDAY.G.28='Samstag'   
  572. WDAY.E.29='Sunday'    
  573. WDAY.G.29='Sonntag'   
  574. WDAY.E.30='Monday'    
  575. WDAY.G.30='Montag'    
  576. WDAY.E.31='Tuesday'   
  577. WDAY.G.31='Dienstag'  
  578. WDAY.E.32='Wednesday' 
  579. WDAY.G.32='Mittwoch'  
  580. WDAY.E.33='Thursday'  
  581. WDAY.G.33='Donnerstag'
  582. WDAY.E.34='Friday'    
  583. WDAY.G.34='Freitag'   
  584. WDAY.E.35='Saturday'  
  585. WDAY.G.35='Samstag'   
  586. WDAY.E.36='Sunday'    
  587. WDAY.G.36='Sonntag'   
  588. WDAY.E.37='Monday'    
  589. WDAY.G.37='Montag'    
  590.  
  591. WDY.1 =Su; WDY.8=Su  ;WDY.15=Su; WDY.22=Su; WDY.29=Su; WDY.36=Su  
  592. WDY.2 =Mo; WDY.9=Mo  ;WDY.16=Mo; WDY.23=Mo; WDY.30=Mo; WDY.37=Mo  
  593. WDY.3 =Tu; WDY.10=Tu ;WDY.17=Tu; WDY.24=Tu; WDY.31=Tu; 
  594. WDY.4 =We; WDY.11=We ;WDY.18=We; WDY.25=We; WDY.32=We; 
  595. WDY.5 =Th; WDY.12=Th ;WDY.19=Th; WDY.26=Th; WDY.33=Th; 
  596. WDY.6 =Fr; WDY.13=Fr ;WDY.20=Fr; WDY.27=Fr; WDY.34=Fr; 
  597. WDY.7 =Sa; WDY.14=Sa ;WDY.21=Sa; WDY.28=Sa; WDY.35=Sa; 
  598.  
  599. WT.1='    ';  WT.8='    ';WT.15='    ';WT.22='    ';WT.29='    ';WT.36='    '; 
  600. WT.2='    ';  WT.9='    ';WT.16='    ';WT.23='    ';WT.30='    ';WT.37='    ';  
  601. WT.3='    '; WT.10='    ';WT.17='    ';WT.24='    ';WT.31='    ';  
  602. WT.4='    '; WT.11='    ';WT.18='    ';WT.25='    ';WT.32='    ';  
  603. WT.5='    '; WT.12='    ';WT.19='    ';WT.26='    ';WT.33='    ';  
  604. WT.6='    '; WT.13='    ';WT.20='    ';WT.27='    ';WT.34='    ';  
  605. WT.7='    '; WT.14='    ';WT.21='    ';WT.28='    ';WT.35='    ';  
  606.  
  607. WY.E.SU = 'Sunday    '
  608. WY.G.SU = 'Sonntag   '
  609. WY.E.MO = 'Monday    '
  610. WY.G.MO = 'Montag    '
  611. WY.E.TU = 'Tuesday   '
  612. WY.G.TU = 'Dienstag  '
  613. WY.E.WE = 'Wednesday '
  614. WY.G.WE = 'Mittwoch  '
  615. WY.E.TH = 'Thursday  '
  616. WY.G.TH = 'Donnerstag'
  617. WY.E.FR = 'Friday    '
  618. WY.G.FR = 'Freitag   '
  619. WY.E.SA = 'Saturday  '
  620. WY.G.SA = 'Samstag   '
  621.  
  622. DAY=DAY+MONTH
  623.  
  624. D=1
  625. Z=0
  626. A=0
  627. WD=1
  628. WT=1
  629. T=1
  630.  
  631. /*----------- ANSI DEFINE --------------*/
  632.  
  633. COL1=''  /* + Border               */
  634. COL2=''  /* + Field 1              */
  635. COL3=''  /* + Field 2              */
  636. COL4=''  /* + Days                 */
  637. COL5=''  /* + Weekdays             */
  638. COL6=''  /* + The Day Field        */
  639. COL7=''  /* + Day in Field         */
  640. COL8=''  /* + Marker in Day Field  */
  641. COL9=''  /* + Month & Year         */
  642.  
  643. /*--------------------------------------*/
  644.  
  645. DO T = 1 TO MON
  646. Z=MONTH+T
  647. WT.Z=T
  648.  
  649.  
  650. MIN=2
  651. IF LENGTH(''WT.Z'')<MIN THEN DO                 /* If Mins only 1 digit */
  652.    WT.Z=INSERT(' ',''WT.Z'')                    /* add 0 for display!   */
  653. END                                       /*                      */
  654.  
  655. IF DAT=WT.Z THEN DO                         /* If Mins only 1 digit */
  656.    WT.Z=INSERT(''COL6'',''COL8'['COL7''WT.Z''COL8']'COL3'')                    /* add 0 for display!   */
  657. END                                       /*                      */
  658.  
  659. MIN3=4
  660. IF LENGTH(''WT.Z'')<MIN3 THEN DO                /* If Mins only 1 digit */
  661.    WT.Z=INSERT(''WT.Z'',' ',1,3,' ')           /* add 0 for display!   */
  662. END                                       /*                      */
  663. SENDSTRING '.'
  664. END T
  665.  
  666.  
  667. Sendstring COPIES('',MON)
  668. Sendstring ''COPIES(' ',MON)''
  669. Sendstring COPIES('',MON)
  670.  
  671. Q4a.E = 'The 'DAT'. of 'MONT.L' 'YER''
  672. Q4b.E = 'was a'
  673. Q4c.E = ''WDAY.L.DAY'.'
  674.  
  675. Q4a.G = 'Der 'DAT'. 'MONT.L' 'YER''
  676. Q4b.G = 'war ein'
  677. Q4c.G = ''WDAY.L.DAY'.'
  678.  
  679. /*--------------------------------------------------------------*/
  680.  
  681.     CECK_YEAR = SUBSTR(''DATE'',7,2,)        /* Aktuelles Jahr      */
  682.     CHECK_YEAR = 19||CECK_YEAR 
  683.     CHECK_YER = YER
  684.  
  685.     IF CHECK_YEAR > CHECK_YER THEN DO        
  686.           Q4b.E = 'was a'
  687.           Q4b.G = 'war ein'
  688.        CALL NEXT2
  689.     END
  690.     IF CHECK_YEAR < CHECK_YER THEN DO        
  691.        Q4b.E = 'is a'
  692.        Q4b.G = 'ist ein'
  693.        CALL NEXT2
  694.     END
  695.  
  696.        CHECK_MONTH = SUBSTR(''DATE'',1,2,)    /* Aktueller Monat    */
  697.        IF CHECK_MONTH > MONT# THEN DO    
  698.  
  699.           Q4b.E = 'was a'
  700.           Q4b.G = 'war ein'
  701.           CALL NEXT2
  702.        END
  703.        IF CHECK_MONTH < MONT# THEN DO    
  704.           Q4b.E = 'is a'
  705.           Q4b.G = 'ist ein'
  706.           CALL NEXT2
  707.        END
  708.  
  709.           CHECK_DAY = SUBSTR(''DATE'',4,2,)    /* Aktueller Tag    */
  710.           IF CHECK_DAY=DAT THEN DO        
  711.              Q4a.E = ' Today it`s 'WDAY.L.DAY'!'
  712.              Q4b.E = '  '
  713.              Q4c.E = '('DAT'. 'MONT.L' 'YER')'
  714.              Q4b.E = ''
  715.              Q4b.G = ''
  716.              Q4a.G = ' Heute ist 'WDAY.L.DAY'!'
  717.              Q4b.G = ''
  718.              Q4c.G = '('DAT'. 'MONT.L' 'YER')'
  719.              CALL NEXT2
  720.           END
  721.  
  722.              IF CHECK_DAY<DAT THEN DO        
  723.                 Q4b.E = 'is a'
  724.                 Q4b.G = 'ist ein'
  725.                 CALL NEXT2
  726.              END
  727.              IF CHECK_DAY>DAT THEN DO        
  728.                 Q4b.E = 'was a'
  729.                 Q4b.G = 'war ein'
  730.              END
  731.  
  732. /*------------------------- Display -----------------------*/
  733.  
  734. NEXT2:
  735.  
  736. MESSAGE 
  737. MESSAGE '                                   'COL1' ___________________________________________'
  738. MESSAGE '                                   'COL1'|'COL2'                                           'COL1'|'
  739. MESSAGE '                                   'COL1'|'COL2' 'COL9''CENTER( MONT.L YER,41)' 'COL1'|'
  740. MESSAGE '                                   'COL1'|'COL2'___________________________________________'COL1'|'
  741. MESSAGE '                                   'COL1'|'COL3'                                           'COL1'|'
  742. MESSAGE '                                   'COL1'|'COL3' 'COL5' 'WY.L.SU'  'COL4''WT.1''COL4' 'WT.8' 'COL4''WT.15' 'COL4''WT.22' 'COL4''WT.29''COL4''WT.36' 'COL1'|'
  743. MESSAGE '    'LEFT(Q4a.l,38)'  'COL1'|'COL3' 'COL5' 'WY.L.MO'  'COL4''WT.2''COL4' 'WT.9' 'COL4''WT.16' 'COL4''WT.23' 'COL4''WT.30''COL4''WT.37' 'COL1'|'
  744. MESSAGE '    'LEFT(Q4b.l Q4c.l,40)'         'COL1'|'COL3' 'COL5' 'WY.L.TU'  'COL4''WT.3''COL4' 'WT.10''COL4' 'WT.17''COL4' 'WT.24''COL4' 'WT.31'     'COL1'|'
  745. MESSAGE '    'LEFT(Q4e Q4d.L SJ2.l,39)'       'COL1'|'COL3' 'COL5' 'WY.L.WE'  'COL4''WT.4''COL4' 'WT.11''COL4' 'WT.18''COL4' 'WT.25''COL4' 'WT.32'     'COL1'|'
  746. MESSAGE '                                   'COL1'|'COL3' 'COL5' 'WY.L.TH'  'COL4''WT.5''COL4' 'WT.12''COL4' 'WT.19''COL4' 'WT.26''COL4' 'WT.33'     'COL1'|'
  747. MESSAGE '                                   'COL1'|'COL3' 'COL5' 'WY.L.FR'  'COL4''WT.6''COL4' 'WT.13''COL4' 'WT.20''COL4' 'WT.27''COL4' 'WT.34'     'COL1'|'
  748. MESSAGE '                                   'COL1'|'COL3' 'COL5' 'WY.L.SA'  'COL4''WT.7''COL4' 'WT.14''COL4' 'WT.21''COL4' 'WT.28''COL4' 'WT.35'     'COL1'|'
  749. MESSAGE '                                   'COL1'|'COL3'___________________________________________'COL1'|'
  750.  
  751.  
  752. Q30a.E= SENDSTRING '[A]gain, [Q]uit: '
  753. Q30a.G= SENDSTRING '[N]ochmal oder [E]nde: '
  754. Q30a.l
  755.   ASK_AGAIN: 
  756.   GETCHAR
  757.   L2 = upper(result) 
  758.   SELECT
  759.     WHEN L2='Q' THEN CALL DONE
  760.     WHEN L2='A' THEN CALL START
  761.     WHEN L2='E' THEN CALL DONE
  762.     WHEN L2='N' THEN CALL START
  763.     OTHERWISE CALL ASK_AGAIN
  764.   END
  765.  
  766.  
  767.  
  768.  
  769. /*---------------------------------------------------------*/
  770.  
  771. DONE:
  772. QUIT.E= SENDSTRING 'Quit'
  773. QUIT.G= SENDSTRING 'Ende'
  774. QUIT.l
  775. MESSAGE
  776. MESSAGE
  777. MESSAGE
  778. MESSAGE '             200 Year Calendar, written for Tempest BBS by Casa Nova.'
  779. MESSAGE 
  780. DONE2:
  781. /*address command 'DELETE ENV:NODE-'BBS_NODE' 'BBS_NODE' quiet' /*InterNode-MSGs*/*/
  782.  
  783. /*---------------------------------------------------------*/
  784. 'exit'
  785. exit
  786.  
  787. SYNTAX:
  788. message "**SYNTAX ERROR** in line: " SIGL " Severity: " RC errortext(RC)
  789. message "Notify Sysop Immediately!! -- Hit any key "
  790. message " "
  791. getchar
  792. 'exit'
  793. exit
  794.  
  795. ERROR:
  796. message "**IO ERROR** in line: " SIGL " Severity: " RC errortext(RC)
  797. message "Notify Sysop Immediately!! -- Hit any key "
  798. message " "
  799. getchar
  800. 'exit'
  801. exit
  802.  
  803. HALT:
  804. message "**HALT** in line: " SIGL " Severity: " RC errortext(RC)
  805. message "Notify Sysop Immediately!! -- Hit any key "
  806. message " "
  807. getchar
  808. 'exit'
  809. exit
  810.  
  811. FAILURE:
  812. message "**FAILURE** in line: " SIGL " Severity: " RC errortext(RC)
  813. message "Notify Sysop Immediately!! -- Hit any key "
  814. message " "
  815. getchar
  816. 'exit'
  817. exit
  818.  
  819. NOVALUE:
  820. message "**NOVALUE** in line: " SIGL " Severity: " RC errortext(RC)
  821. message "Notify Sysop Immediately!! -- Hit any key "
  822. message " "
  823. getchar
  824. 'exit'
  825. exit
  826.  
  827. IOERR:
  828. message "**IOERR** in 'programname' line: " SIGL " Severity: " RC errortext(RC)
  829. message "Notify Sysop Immediately!! -- Hit any key "
  830. message " "
  831. getchar
  832. 'exit'
  833. exit
  834.  
  835.